home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / ENCRYPT.SWG / 0013_SOUNDEX.PAS.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  1KB  |  74 lines
  1. {
  2. REYNIR STEFANSSON
  3.  
  4. Somebody was saying something about Soundex hashing. Here is my
  5. Implementation of that:
  6. }
  7.  
  8. Unit Soundex;
  9.  
  10. Interface
  11.  
  12. Type
  13.   Sdx4 = String[4];
  14.  
  15. Function SoundexOf(WorkStr : String) : Sdx4;
  16.  
  17. Implementation
  18.  
  19. Var
  20.   Group : Array[0..6] of String[8];
  21.  
  22. Function ValidityOf(Letter : Char) : Char;
  23. Var
  24.   Valu, j : Integer;
  25.   Chs     : String[8];
  26. begin
  27.   For Valu := 0 to 6 DO
  28.   begin
  29.     Chs := Group[Valu];
  30.     For j := 1 to Length(Chs) DO
  31.     begin
  32.       if UpCase(Letter) = Chs[j] then
  33.         ValidityOf := Chr(48+Valu);
  34.     end;
  35.   end;
  36. end;
  37.  
  38. Function SoundexOf(WorkStr : String) : Sdx4;
  39. Var
  40.   Sndex : Sdx4;
  41.   Oval,
  42.   Valu  : Char;
  43.   i     : Integer;
  44. begin
  45.   Sndex := Copy(WorkStr, 1, 1);
  46.   Oval  := ValidityOf(WorkStr[1]);
  47.   For i := 2 to Length(WorkStr) DO
  48.   begin
  49.     Valu := ValidityOf(WorkStr[i]);
  50.     if (Valu <> '0') and (Valu <> Oval) then
  51.       Sndex := Sndex + Valu;
  52.     Oval := Valu;
  53.   end;
  54.   Sndex := Sndex + '000';
  55.   SoundexOf := Sndex;
  56. end;
  57.  
  58. begin
  59.   Group[0] := 'AEHIOUWY';
  60.   Group[1] := 'BFPV';
  61.   Group[2] := 'CGJKQSXZ';
  62.   Group[3] := 'DT';
  63.   Group[4] := 'L';
  64.   Group[5] := 'MN';
  65.   Group[6] := 'R';
  66. end.
  67.  
  68. {
  69. A Soundex-String looks like: `G032', one letter and three numbers.
  70. Donald Knuth wrote about Soundexing in his _Art of Computer Programming_
  71. series. I got my information out of Personal ComputerWorld (PCW), which in
  72. turn got it from Knuth.
  73. }
  74.